home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / m_to_r / popupbox / example1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  5.1 KB  |  208 lines
  1. unit Example1;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, TabNotBk, StdCtrls, ExtCtrls, Mainclss, Popupbox, Buttons;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     TabbedNotebook1: TTabbedNotebook;
  12.     Label1: TLabel;
  13.     Image1: TImage;
  14.     Label2: TLabel;
  15.     Label3: TLabel;
  16.     Label4: TLabel;
  17.     Edit1: TEdit;
  18.     Edit2: TEdit;
  19.     PopupBox1: TPopupBox;
  20.     Label5: TLabel;
  21.     Label6: TLabel;
  22.     Label7: TLabel;
  23.     Label8: TLabel;
  24.     Bevel1: TBevel;
  25.     Label9: TLabel;
  26.     GroupBox1: TGroupBox;
  27.     Label10: TLabel;
  28.     CheckBox1: TCheckBox;
  29.     CheckBox2: TCheckBox;
  30.     PopupBox2: TPopupBox;
  31.     Label11: TLabel;
  32.     PopupBox3: TPopupBox;
  33.     Label12: TLabel;
  34.     PopupBox6: TPopupBox;
  35.     Label15: TLabel;
  36.     PopupBox7: TPopupBox;
  37.     Label16: TLabel;
  38.     Label17: TLabel;
  39.     Label18: TLabel;
  40.     Label19: TLabel;
  41.     Label20: TLabel;
  42.     Label21: TLabel;
  43.     Label22: TLabel;
  44.     Image2: TImage;
  45.     Image3: TImage;
  46.     Image4: TImage;
  47.     Image5: TImage;
  48.     Image6: TImage;
  49.     Image7: TImage;
  50.     Label23: TLabel;
  51.     Label24: TLabel;
  52.     BitBtn1: TBitBtn;
  53.     Label14: TLabel;
  54.     PopupBox5: TPopupBox;
  55.     PopupBox4: TPopupBox;
  56.     Label13: TLabel;
  57.     Bevel2: TBevel;
  58.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  59.     procedure Edit2KeyPress(Sender: TObject; var Key: Char);
  60.     procedure CheckBox1Click(Sender: TObject);
  61.     procedure CheckBox2Click(Sender: TObject);
  62.     procedure FormShow(Sender: TObject);
  63.     procedure PopupBox7DrawListItem(Control: TWinControl; Index: Integer;
  64.       Rect: TRect; State: TOwnerDrawState);
  65.     procedure PopupBox7Enter(Sender: TObject);
  66.     procedure PopupBox7Exit(Sender: TObject);
  67.     procedure BitBtn1Click(Sender: TObject);
  68.     procedure PopupBox2Enter(Sender: TObject);
  69.     procedure PopupBox3Enter(Sender: TObject);
  70.   private
  71.     { Private-Deklarationen }
  72.   public
  73.     { Public-Deklarationen }
  74.   end;
  75.  
  76. var
  77.   Form1: TForm1;
  78.  
  79. implementation
  80.  
  81. {$R *.DFM}
  82.  
  83. procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  84. begin
  85.   if Key = #13 then begin
  86.     Key:= #0;
  87.     PostMessage(Handle, WM_NextDlgCtl, 0, 0);
  88.   end;
  89. end;
  90.  
  91. procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
  92. begin
  93.   if Key = #13 then begin
  94.     Key:= #0;
  95.     Edit1.SetFocus;
  96.   end;
  97. end;
  98.  
  99. procedure TForm1.CheckBox1Click(Sender: TObject);
  100. begin
  101.   PopupBox1.GoAwayOnCLick:= CheckBox1.Checked;
  102.   PopupBox1.SetFocus;
  103. end;
  104.  
  105. procedure TForm1.CheckBox2Click(Sender: TObject);
  106. begin
  107.   PopupBox1.GoAwayOnReturn:= CheckBox2.Checked;
  108.   PopupBox1.SetFocus;
  109. end;
  110.  
  111. procedure TForm1.FormShow(Sender: TObject);
  112. VAR
  113.   i: Integer;
  114. begin
  115.   PopupBox7.Text:= DateToStr(Date);
  116.   { PopupBox-field gets a textcolor:
  117.      -> working day = black
  118.      -> saturday = dark red
  119.      -> sunday = dark blue }
  120.   Case DayOfWeek(Date) Of
  121.     1: PopupBox7.Font.Color:= clMaroon;
  122.     2..6: PopupBox7.Font.Color:= clBlack;
  123.     7: PopupBox7.Font.Color:= clNavy;
  124.   End;
  125.  
  126.   PopupBox7.ListItems.Clear;
  127.   for i:= -14 to 14 do begin
  128.     PopupBox7.ListItems.Add(DateToStr(Date + i));
  129.   end;
  130. end;
  131.  
  132. procedure TForm1.PopupBox7DrawListItem(Control: TWinControl;
  133.   Index: Integer; Rect: TRect; State: TOwnerDrawState);
  134. VAR
  135.   CurrDate: TDateTime;
  136. begin
  137.   CurrDate:= StrToDate(PopupBox7.ListItems[Index]);
  138.   with (Control as TPopupBoxListBox).Canvas do begin
  139.     Case DayOfWeek(CurrDate) Of
  140.       1 : begin  {Sunday}
  141.         Font.Color:= clRed;
  142.         Font.Style:= Font.Style + [fsBold];
  143.       end;
  144.  
  145.       7 : begin  {Saturday}
  146.         Font.Color:= clNavy;
  147.         Font.Style:= Font.Style + [fsBold];
  148.       end;
  149.     End;
  150.     TextRect(Rect, Rect.Left, Rect.Top, PopupBox7.ListItems[Index] + ', ' +
  151.                      FormatDateTime('dddd', CurrDate));
  152.   end;
  153. end;
  154.  
  155. procedure TForm1.PopupBox7Enter(Sender: TObject);
  156. VAR
  157.   CurrDate: TDateTime;
  158.   i: Integer;
  159. begin
  160.   {we have to select ourself the correct date in the list;
  161.    notify that ListAutoPos is set to False}
  162.   try
  163.     CurrDate:= StrToDate(PopupBox7.Text);
  164.   except
  165.     on EConvertError do CurrDate:= Date;
  166.   end;
  167.  
  168.   for i:= 0 to PopupBox7.ListItems.Count-1 do
  169.     if StrToDate(PopupBox7.ListItems[i]) = CurrDate then begin
  170.       PopupBox7.List.ItemIndex:= i;
  171.       if i >= 3 then Popupbox7.List.TopIndex:= i - 3;
  172.       exit; {we found the correct date and stop}
  173.     end;
  174. end;
  175.  
  176. procedure TForm1.PopupBox7Exit(Sender: TObject);
  177. begin
  178.   {PopupBox-field also gets the color}
  179.   Case DayOfWeek(StrToDate(PopupBox7.Text)) Of
  180.     1: PopupBox7.Font.Color:= clMaroon;
  181.     2..6: PopupBox7.Font.Color:= clBlack;
  182.     7: PopupBox7.Font.Color:= clNavy;
  183.   End;
  184. end;
  185.  
  186. procedure TForm1.BitBtn1Click(Sender: TObject);
  187. VAR
  188.   TempBuf: Array[0..300] of Char;
  189. begin
  190.   strPCopy(TempBuf, 'write.exe '+
  191.            ExtractFilePath(Application.ExeName)+'readme.wri');
  192.   WinExec(TempBuf, SW_SHOW);
  193. end;
  194.  
  195.  
  196. procedure TForm1.PopupBox2Enter(Sender: TObject);
  197. begin
  198.   Popupbox2.List.ItemIndex:= DayOfWeek(Date)-1;
  199. end;
  200.  
  201. procedure TForm1.PopupBox3Enter(Sender: TObject);
  202. begin
  203.   Popupbox3.List.ItemIndex:= 4;
  204.   Popupbox3.List.TopIndex:= 2;
  205. end;
  206.  
  207. end.
  208.